﻿Imports DirectShowLib
Imports System.Runtime.InteropServices
Imports System.Threading
Imports System.Drawing.Imaging
Imports UCBase
Imports System.Windows.Forms
Imports System.Drawing

Public Class AutoTriggerCamera
    Implements ISampleGrabberCB
    Implements IDisposable
    Implements I_ImageExchange
    Implements UCBase.I_LoadSave
    Implements UCBase.I_EditMode
    <DllImport("Kernel32.dll", EntryPoint:="RtlMoveMemory")> _
    Private Shared Sub CopyMemory(ByVal Destination As IntPtr, ByVal Source As IntPtr, <MarshalAs(UnmanagedType.U4)> ByVal Length As Integer)
    End Sub

    Private capDevices As DsDevice()
    Private m_FilterGraph As IFilterGraph2 = Nothing
    Private m_VidControl As IAMVideoControl = Nothing
    Private m_pinStill As IPin = Nothing
    Private m_rot As DsROTEntry = Nothing
    Private m_ip As IntPtr = IntPtr.Zero
    Private m_CamControl As IAMCameraControl = Nothing
    Private m_VideoProcAmp As IAMVideoProcAmp = Nothing
    Private M_Capture As IAMStreamConfig = Nothing
    Private m_PictureReady As ManualResetEvent = Nothing
    Private m_WantOne As Boolean = False
    Private m_videoWidth As Integer
    Private m_videoHeight As Integer
    Private m_stride As Integer
    Private m_bits As Integer
    Private m_ipBuffer As IntPtr = IntPtr.Zero
    Private M_ResolutionModes As New Collection
    Private SelectedDevice As Integer
    Private SelectedPreviewMode As Integer
    Private SelectedCaptureMode As Integer
    Private M_VidWin As PictureBox
    Private M_RUN As Boolean = False
    Private BackPic As New BackgroundCreator
    Private CanPreview As Boolean = False
    Private InternalPreview As Boolean = True
    Private HaveVidWin As Boolean = False
    Private Mov As New Mover
    Private M_Edit As Boolean = True

    Private M_ImageEnabled As Boolean = False
    Private M_ImageConnected As Boolean = False
    Private M_auto_Trigger As Boolean = True
    Private M_Devices As New List(Of String)
    Private M_Mode As New List(Of String)
    Private SelectCamera As New CamSelect

    Private Sub Camera_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        capDevices = DsDevice.GetDevicesOfCat(FilterCategory.VideoInputDevice)
        m_PictureReady = New ManualResetEvent(False)
        Me.BackgroundImage = BackPic.CreatePic(Me.Width, Me.Height)
        Mov.Connect(Me)
        Label7.Text = Me.Name
    End Sub
    Private Sub Camera_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        Me.Width = 340 '341, 163
        Me.Height = 165
    End Sub
    Private Sub SetupGraph()
        Dim hr As Integer

        Dim sampGrabber As ISampleGrabber = Nothing
        Dim capFilter As IBaseFilter = Nothing
        Dim pCaptureOut As IPin = Nothing
        Dim pSampleIn As IPin = Nothing
        Dim pRenderIn As IPin = Nothing
        Dim dev As DsDevice = capDevices(SelectedDevice)
        m_FilterGraph = TryCast(New FilterGraph(), IFilterGraph2)
        Try
#If DEBUG Then
            m_rot = New DsROTEntry(m_FilterGraph)
#End If
            hr = m_FilterGraph.AddSourceFilterForMoniker(dev.Mon, Nothing, dev.Name, capFilter)
            DsError.ThrowExceptionForHR(hr)
            m_CamControl = TryCast(capFilter, IAMCameraControl)
            m_VideoProcAmp = TryCast(capFilter, IAMVideoProcAmp)
            If m_pinStill Is Nothing Then
                Dim pRaw As IPin = Nothing
                Dim pSmart As IPin = Nothing
                m_VidControl = Nothing
                Dim iSmartTee As IBaseFilter = DirectCast(New SmartTee(), IBaseFilter)
                Try
                    hr = m_FilterGraph.AddFilter(iSmartTee, "SmartTee")
                    DsError.ThrowExceptionForHR(hr)
                    pRaw = DsFindPin.ByCategory(capFilter, PinCategory.Capture, 0)
                    pSmart = DsFindPin.ByDirection(iSmartTee, PinDirection.Input, 0)
                    hr = m_FilterGraph.Connect(pRaw, pSmart)
                    DsError.ThrowExceptionForHR(hr)
                    m_pinStill = DsFindPin.ByName(iSmartTee, "Preview")
                    pCaptureOut = DsFindPin.ByName(iSmartTee, "Capture")
                    SetConfigParms(pRaw)
                Finally
                    If pRaw IsNot Nothing Then
                        Marshal.ReleaseComObject(pRaw)
                    End If
                    If pRaw IsNot pSmart Then
                        Marshal.ReleaseComObject(pSmart)
                    End If
                    If pRaw IsNot iSmartTee Then
                        Marshal.ReleaseComObject(iSmartTee)
                    End If
                End Try
            Else
                m_VidControl = TryCast(capFilter, IAMVideoControl)
                pCaptureOut = DsFindPin.ByCategory(capFilter, PinCategory.Capture, 0)
                M_Capture = TryCast(pCaptureOut, IAMStreamConfig)
                SetConfigParms(m_pinStill)
            End If
            sampGrabber = TryCast(New SampleGrabber(), ISampleGrabber)
            Dim baseGrabFlt As IBaseFilter = TryCast(sampGrabber, IBaseFilter)
            ConfigureSampleGrabber(sampGrabber)
            pSampleIn = DsFindPin.ByDirection(baseGrabFlt, PinDirection.Input, 0)
            Dim pRenderer As IBaseFilter = TryCast(New VideoRendererDefault(), IBaseFilter)
            hr = m_FilterGraph.AddFilter(pRenderer, "Renderer")
            DsError.ThrowExceptionForHR(hr)

            pRenderIn = DsFindPin.ByDirection(pRenderer, PinDirection.Input, 0)
            hr = m_FilterGraph.AddFilter(baseGrabFlt, "Ds.NET Grabber")
            DsError.ThrowExceptionForHR(hr)

            If m_VidControl Is Nothing Then
                hr = m_FilterGraph.Connect(m_pinStill, pSampleIn)
                DsError.ThrowExceptionForHR(hr)
                hr = m_FilterGraph.Connect(pCaptureOut, pRenderIn)
                DsError.ThrowExceptionForHR(hr)
            Else
                hr = m_FilterGraph.Connect(pCaptureOut, pRenderIn)
                DsError.ThrowExceptionForHR(hr)
                hr = m_FilterGraph.Connect(m_pinStill, pSampleIn)
                DsError.ThrowExceptionForHR(hr)
            End If
            SaveSizeInfo(sampGrabber)
            ConfigVideoWindow(PictureBox1)
            Dim mediaCtrl As IMediaControl = TryCast(m_FilterGraph, IMediaControl)
            hr = mediaCtrl.Run()
            DsError.ThrowExceptionForHR(hr)
        Finally
            If sampGrabber IsNot Nothing Then
                Marshal.ReleaseComObject(sampGrabber)
                sampGrabber = Nothing
            End If
            If pCaptureOut IsNot Nothing Then
                Marshal.ReleaseComObject(pCaptureOut)
                pCaptureOut = Nothing
            End If
            If pRenderIn IsNot Nothing Then
                Marshal.ReleaseComObject(pRenderIn)
                pRenderIn = Nothing
            End If
            If pSampleIn IsNot Nothing Then
                Marshal.ReleaseComObject(pSampleIn)
                pSampleIn = Nothing
            End If
        End Try
        M_RUN = True
    End Sub
    Private Sub ConfigureSampleGrabber(ByVal sampGrabber As ISampleGrabber)
        Dim hr As Integer
        Dim media As New AMMediaType()
        media.majorType = MediaType.Video
        media.subType = MediaSubType.RGB24
        media.formatType = FormatType.VideoInfo
        hr = sampGrabber.SetMediaType(media)
        DsError.ThrowExceptionForHR(hr)
        DsUtils.FreeAMMediaType(media)
        media = Nothing
        hr = sampGrabber.SetCallback(Me, 1)
        DsError.ThrowExceptionForHR(hr)
    End Sub
    Private Sub SaveSizeInfo(ByVal sampGrabber As ISampleGrabber)
        Dim hr As Integer
        Dim media As New AMMediaType()
        hr = sampGrabber.GetConnectedMediaType(media)
        DsError.ThrowExceptionForHR(hr)
        If (media.formatType <> FormatType.VideoInfo) OrElse (media.formatPtr = IntPtr.Zero) Then
            Throw New NotSupportedException("Unknown Grabber Media Format")
        End If
        Dim videoInfoHeader As VideoInfoHeader = DirectCast(Marshal.PtrToStructure(media.formatPtr, GetType(VideoInfoHeader)), VideoInfoHeader)
        m_videoWidth = videoInfoHeader.BmiHeader.Width
        m_videoHeight = videoInfoHeader.BmiHeader.Height
        m_stride = m_videoWidth * (videoInfoHeader.BmiHeader.BitCount / 8)
        m_bits = videoInfoHeader.BmiHeader.BitCount
        DsUtils.FreeAMMediaType(media)
        media = Nothing
    End Sub

    Private Sub ConfigVideoWindow(ByVal hControl As Control)
        Dim hr As Integer
        Dim ivw As IVideoWindow = TryCast(m_FilterGraph, IVideoWindow)
        hr = ivw.put_Owner(hControl.Handle)
        DsError.ThrowExceptionForHR(hr)
        hr = ivw.put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipChildren Or WindowStyle.ClipSiblings)
        DsError.ThrowExceptionForHR(hr)
        If InternalPreview = False Then
            hr = ivw.put_Visible(OABool.True)
            DsError.ThrowExceptionForHR(hr)
        Else
            hr = ivw.put_Visible(OABool.False)
            DsError.ThrowExceptionForHR(hr)
        End If
        Dim rc As Rectangle = hControl.ClientRectangle
        Dim r As Double = m_videoWidth / m_videoHeight
        Dim w As Integer = hControl.Height * r
        Dim L As Integer = (hControl.Width / 2) - (w / 2)
        hr = ivw.SetWindowPosition(L, 0, w, hControl.Height)
        DsError.ThrowExceptionForHR(hr)
    End Sub
    Private Sub SetConfigParms(ByVal pStill As IPin)
        Dim hr As Integer
        Dim streamConfig As IAMStreamConfig = DirectCast(pStill, IAMStreamConfig)
        Dim searchmedia As AMMediaType = Nothing
        Dim CorectvidFormat As New AMMediaType()
        Dim ptr As IntPtr
        Dim piCount As Integer, piSize As Integer
        hr = streamConfig.GetNumberOfCapabilities(piCount, piSize)
        ptr = Marshal.AllocCoTaskMem(piSize)
        For i As Integer = 0 To piCount - 1
            hr = streamConfig.GetStreamCaps(i, searchmedia, ptr)
            Dim v As New VideoInfoHeader()
            Marshal.PtrToStructure(searchmedia.formatPtr, v)
            If i = SelectedPreviewMode Then
                CorectvidFormat = searchmedia
            End If
        Next
        hr = streamConfig.SetFormat(CorectvidFormat)
    End Sub
    Private Sub CloseInterfaces()
        Dim hr As Integer
        Try
            If m_FilterGraph IsNot Nothing Then
                Dim mediaCtrl As IMediaControl = TryCast(m_FilterGraph, IMediaControl)
                hr = mediaCtrl.[Stop]()
            End If
        Catch ex As Exception
            Debug.WriteLine(ex)
        End Try
        If m_FilterGraph IsNot Nothing Then
            Marshal.ReleaseComObject(m_FilterGraph)
            m_FilterGraph = Nothing
        End If
        If m_VidControl IsNot Nothing Then
            Marshal.ReleaseComObject(m_VidControl)
            m_VidControl = Nothing
        End If
        If m_pinStill IsNot Nothing Then
            Marshal.ReleaseComObject(m_pinStill)
            m_pinStill = Nothing
        End If
    End Sub

    Private Function ISampleGrabberCB_SampleCB(ByVal SampleTime As Double, ByVal pSample As IMediaSample) As Integer Implements ISampleGrabberCB.SampleCB
        Marshal.ReleaseComObject(pSample)
        Return 0
    End Function
    Private Function ISampleGrabberCB_BufferCB(ByVal SampleTime As Double, ByVal pBuffer As IntPtr, ByVal BufferLen As Integer) As Integer Implements ISampleGrabberCB.BufferCB
        Debug.Assert(BufferLen = Math.Abs(m_stride) * m_videoHeight, "Incorrect buffer length")

        If m_WantOne Then
            m_WantOne = False
            Debug.Assert(m_ipBuffer <> IntPtr.Zero, "Unitialized buffer")
            CopyMemory(m_ipBuffer, pBuffer, BufferLen)
            m_PictureReady.[Set]()
        End If
        Return 0
    End Function
    Public Sub GetImage()
        If M_RUN = False Then Exit Sub
        If BackgroundWorker1.IsBusy = False Then
            BackgroundWorker1.RunWorkerAsync()
        End If
    End Sub
    Public ReadOnly Property Running() As Boolean
        Get
            Return M_RUN
        End Get
    End Property
    Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
        Dim hr As Integer
        m_PictureReady.Reset()
        m_ipBuffer = Marshal.AllocCoTaskMem(Math.Abs(m_stride) * m_videoHeight)
        Try
            m_WantOne = True
            If m_VidControl IsNot Nothing Then
                hr = m_VidControl.SetMode(m_pinStill, VideoControlFlags.Trigger)
                DsError.ThrowExceptionForHR(hr)
            End If
            If Not m_PictureReady.WaitOne(9000, False) Then
                Throw New Exception("Timeout waiting to get picture")
            End If
        Catch
            Marshal.FreeCoTaskMem(m_ipBuffer)
            m_ipBuffer = IntPtr.Zero
        End Try
        If m_ip <> IntPtr.Zero Then
            Marshal.FreeCoTaskMem(m_ip)
            m_ip = IntPtr.Zero
        End If
        m_ip = m_ipBuffer
        Dim pf As PixelFormat
        If m_bits = 24 Then pf = PixelFormat.Format24bppRgb
        If m_bits = 16 Then pf = PixelFormat.Format16bppRgb555
        Dim b As New Bitmap(m_videoWidth, m_videoHeight, m_stride, pf, m_ip)
        b.RotateFlip(RotateFlipType.RotateNoneFlipY)
        If b.PixelFormat <> PixelFormat.Format24bppRgb Then
            Dim temp As Bitmap = AForge.Imaging.Image.Clone(b, PixelFormat.Format24bppRgb)
            b.Dispose()
            b = temp
        End If
        e.Result = b
    End Sub
    Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
        If ImageOut.Connected And ImageOut.SocketsEnable Then
            RaiseEvent ImageReady(e.Result)
            If M_auto_Trigger = True Then
                GetImage()
            End If
        End If
    End Sub
    Private Sub Button3D5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3D5.Click
        If CanPreview = True Then
            If ImageOut.SocketsEnable = False Then
                ImageOut.SocketsEnable = True
                GetImage()
            Else
                ImageOut.SocketsEnable = False
            End If
        End If
    End Sub
    Public Event ImageReady(ByVal Image As System.Drawing.Bitmap) Implements I_ImageExchange.ImageOut1
    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub
    Private Sub Button3D1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3D1.Click
        SelectCamera.NameText.Text = Me.Name
        If SelectCamera.ShowDialog() = DialogResult.OK Then
            M_RUN = False
            SelectedDevice = SelectCamera.Device
            SelectedPreviewMode = SelectCamera.Mode
            CanPreview = True
            CloseInterfaces()
            SetupGraph()
            Me.Name = SelectCamera.NameText.Text
            Label7.Text = Me.Name
        End If
    End Sub
    Public Function GetSettings() As String Implements UCBase.I_LoadSave.GetSettings
        'ImageOut.SocketsEnable = True
        'GetImage()
        Return "Device=" & SelectedDevice.ToString & ",Mode=" & SelectedPreviewMode.ToString
    End Function
    Public Sub SetSettings(ByVal Settings As String) Implements UCBase.I_LoadSave.SetSettings
        M_RUN = False
        Dim Tmp() As String = Settings.Split(",")
        Dim TmpB() As String = Tmp(0).Split("=")
        SelectedDevice = Val(TmpB(1))
        Dim TmpC() As String = Tmp(1).Split("=")
        SelectedPreviewMode = Val(TmpC(1))
        CanPreview = True
        CloseInterfaces()
        SetupGraph()
        SelectCamera.Device = SelectedDevice
        SelectCamera.Mode = SelectedPreviewMode
        SelectCamera.NameText.Text = Me.Name

    End Sub

    Public Sub SetEditMode(ByVal Mode As UCBase.Diagram.EditMode) Implements UCBase.I_EditMode.SetEditMode
        If Mode = Diagram.EditMode.Unlocked Then
            M_Edit = True
            Mov.EditMode = True
            Button3D1.Visible = True
        Else
            M_Edit = False
            Mov.EditMode = False
            Button3D1.Visible = False
        End If
    End Sub

    Public Sub New()

        ' This call is required by the Windows Form Designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
        Me.UpdateStyles()
    End Sub
End Class
